home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fontro / font.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  3.5 KB  |  102 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   5595
  5.    ClientLeft      =   1170
  6.    ClientTop       =   1545
  7.    ClientWidth     =   4830
  8.    Height          =   6000
  9.    Left            =   1110
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   5595
  13.    ScaleWidth      =   4830
  14.    Top             =   1200
  15.    Width           =   4950
  16.    Begin CommandButton Command2 
  17.       Caption         =   "DONE"
  18.       Height          =   735
  19.       Left            =   3000
  20.       TabIndex        =   3
  21.       Top             =   4800
  22.       Width           =   1575
  23.    End
  24.    Begin CommandButton Command1 
  25.       Caption         =   "Sideways Print Test: GO"
  26.       Height          =   735
  27.       Left            =   240
  28.       TabIndex        =   0
  29.       Top             =   4800
  30.       Width           =   2535
  31.    End
  32.    Begin PictureBox Pic 
  33.       Height          =   3615
  34.       Left            =   120
  35.       ScaleHeight     =   3585
  36.       ScaleWidth      =   4545
  37.       TabIndex        =   4
  38.       Top             =   1080
  39.       Width           =   4575
  40.    End
  41.    Begin Label Label2 
  42.       Height          =   375
  43.       Left            =   960
  44.       TabIndex        =   2
  45.       Top             =   600
  46.       Width           =   2775
  47.    End
  48.    Begin Label Label1 
  49.       Height          =   375
  50.       Left            =   360
  51.       TabIndex        =   1
  52.       Top             =   120
  53.       Width           =   4095
  54.    End
  55. Sub Command1_Click ()
  56. Dim hFont As Integer, hOldFont As Integer
  57. Dim Font As LOGFONT
  58. '-- get Text capabilites for rotating characters
  59. ' Funny Note: There's a POLYGONALCAPS capability which determines whether the device can
  60. '             do interiors.  I wonder if I can hire it to redecorate my place? 8-)
  61. nValue = GetDeviceCaps(Form1.hDC, TEXTCAPS)
  62. Label2.Caption = "TEXTCAPS" + ":" + Hex$(nValue)
  63. If (nValue And TC_CR_90) = 0 Then
  64.     Label1.Caption = "No Character Rotation is Available"
  65.     If (nValue And TC_CR_ANY) = 0 Then
  66.         Label1.Caption = "90 Degree Character Rotation Available"
  67.     Else
  68.         Label1.Caption = "Any Degree Character Rotation Available"
  69.     End If
  70. End If
  71. '-- Note: at this point if it can't do CharRot's, then we should stop, but we'll blindly
  72. '   forge ahead to see what happens.
  73. Font.lfHeight = 24  '-- 24 point size
  74. Font.lfWidth = 0'-- let Windows figure out the appropriate width based on the height
  75. Font.lfEscapement = 900'-- rotate 270 degrees (bottom to top)
  76. Font.lfOrientation = 900  '-- normal character orientation (straight up)
  77. Font.lfPitchAndFamily = Chr$(VARIABLE_PITCH Or FF_MODERN)
  78. Font.lfCharSet = Chr$(OEM_CHARSET)  '-- this is important!
  79. Font.lfQuality = Chr$(PROOF_QUALITY)
  80. Font.lfWeight = FW_NORMAL
  81. 'Note: italic, underline, strikeout, charset, outprecision,
  82. '      clipprecision, and quality are 0 (default)
  83. Font.lfFaceName = "Modern"'-- Windows' "Modern" font
  84. '-- get the handle to the font we specify
  85. hFont = CreateFontIndirect(Font)
  86. '-- now let's select it to our current Printer hDC
  87. hOldFont = SelectObject(Pic.hDC, hFont)
  88. szFaceName$ = Space$(80)
  89. retval% = GetTextFace(Pic.hDC, 79, szFaceName$)
  90. Label2.Caption = Label2.Caption + " " + szFaceName$
  91. '-- let's test it out!
  92. SomeText$ = "This is a test of sideways text 1234567890."
  93. nChars = Len(SomeText$)
  94. Pic.CurrentX = 200
  95. Pic.CurrentY = 3000
  96. Pic.Print "Print Test 1234567890"
  97. '-- don't forget to delete the object
  98. DeleteObject hFont
  99. End Sub
  100. Sub Command2_Click ()
  101. End Sub
  102.